VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form frmSocket 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Interval        =   500
      Left            =   720
      Top             =   0
   End
   Begin MSWinsockLib.Winsock wscFXRS 
      Left            =   0
      Top             =   0
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
      LocalPort       =   2011
   End
End
Attribute VB_Name = "frmSocket"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit


Dim m_strDataArrival As String
Dim m_strSendData As String
Dim WithEvents m_frmODBCTrans As frmODBCTrans
Attribute m_frmODBCTrans.VB_VarHelpID = -1
'


'---------------------------------------------------------------------------------------
' Procedure : SendData
' DateTime  : 2/18/2004
' Purpose   : Sends the strTrans passed to FXRS
'---------------------------------------------------------------------------------------
'
Public Sub SendData(ByVal strTrans As String)
    
    On Error GoTo EH
    g_strErrorLocation = "frmSocket:SendData"
    
    DebugPrint "SendData, trans " & strTrans
    
    '01/10/06 Moved ProcessTransIn to frmDebug
    If g_blnDebug Then
        With frmDebug
            .Show vbModeless, frmShip
            .txtTransIn = strTrans
            '6/09/06 Clear Output trans when new Input trans received
            '.txtTransOut = ""
            '6/09/06 Added Auto-Send
            If .chkAutoSend = 1 Then .cmdSend = True
        End With
    Else
        ' debugprint "Socket, SendData " & strTrans
        ' debugprint "Socket, SendData, " & strTrans
        'Send the transaction for each pkg.
        wscFXRS.SendData strTrans
    End If
    
    Exit Sub
EH:
     MsgBox Err.Description, vbCritical, g_strErrorLocation
End Sub


Private Sub Form_Initialize()
    ' debugprint "Form_Initialize"
    ' debugprint "Form_Initialize"
    Load Me
End Sub

Private Sub m_frmODBCTrans_ReplyTransaction(strTransOut As String)

    Call SendData(strTransOut)
    
End Sub

'---------------------------------------------------------------------------------------
' Procedure : Timer1_Timer()
' DateTime  : 4/9/2004
' Modified  : 8/20/2004
' Change    : Added FormLoadComplete boolean to here
' Purpose   : Updates status bar with Winsock state info
'---------------------------------------------------------------------------------------
'
Private Sub Timer1_Timer()
    On Error GoTo EH
    Static lngState As Long
    
    g_strErrorLocation = "frmSocket:Timer1_Timer"
    If lngState <> wscFXRS.State Then
        DebugPrint "Socket, state change, from " & lngState & " to " & wscFXRS.State
        lngState = wscFXRS.State
    End If
    Select Case wscFXRS.State
        Case 0
            wscFXRS.Listen

'            StatusBar1.Panels(1).Text = "Disconnected from FSMS"
'        Case 1
'            StatusBar1.Panels(1).Text = "Socket Open"
'        Case 2
'            StatusBar1.Panels(1).Text = "Listening"
'        Case 3
'            StatusBar1.Panels(1).Text = "Connection Pending"
'        Case 4
'            StatusBar1.Panels(1).Text = "Resolving Host"
'        Case 5
'            StatusBar1.Panels(1).Text = "Host Resolved"
'        Case 6
'            StatusBar1.Panels(1).Text = "Connecting"
'        Case 7
'            StatusBar1.Panels(1).Text = "Connected to FSMS"
        Case 8
            wscFXRS.Close
            
            
    End Select
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation

End Sub


'---------------------------------------------------------------------------------------
' Procedure : wscFXRS_Connect
' DateTime  : 12/08/2003
' Purpose   : Winsock connect event. Change mnuConnect caption to Disconnect and enable
'             all buttons that require FXRS connectivity.
'---------------------------------------------------------------------------------------
'
Private Sub wscFXRS_Connect()
    ' debugprint "wscFXRS_Connect"
    ' debugprint "wscFXRS_Connect"
'        mnuConnect.Caption = "&Disconnect"
'        StatusBar1.Panels(1).Text = "Connected to " & frmSetup.cboFXRSIP
'        StatusBar1.Panels(2) = ""
'        Call EnableButtons
End Sub


Private Sub wscFXRS_ConnectionRequest(ByVal requestID As Long)
    wscFXRS.Close
    wscFXRS.Accept requestID
End Sub

'---------------------------------------------------------------------------------------
' Procedure : wscFXRS_Error
' DateTime  : 12/08/2003
' Modified  : 9/8/2004 - Changed message to support multiple hosts. If only one host
'             show error and Retry/Cancel, if 2 hosts show OK/Cancel to try the  backup,
'             else show OK/Cancel to show Setup to select which host to try.
' Purpose   : Winsock error event. Show error MsgBox, close connection and enable
'             Connect button.
'---------------------------------------------------------------------------------------
'
Private Sub wscFXRS_Error(ByVal number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    On Error GoTo EH
    g_strErrorLocation = "frmSocket:wscFXRS_Error"
    
    Dim strMessage As String
    Dim ret As Integer
    Dim i As Integer
   
    wscFXRS.Close
    
    strMessage = "Error occurred on client socket:  " & vbCrLf
    strMessage = strMessage & Description & vbCrLf
    strMessage = strMessage & "Please notify your system administrator."
    
    MsgBox strMessage, vbApplicationModal, "Communication Error"

    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation

End Sub
'


'---------------------------------------------------------------------------------------
' Procedure : wscFXRS_DataArrival
' DateTime  : 12/08/2003
' Purpose   : Winsock DataArrival event. Once 99,"" is received call g_clsParser.ParseData
'             method.
'---------------------------------------------------------------------------------------
'
Private Sub wscFXRS_DataArrival(ByVal bytesTotal As Long)
    Dim strReply As String    'var to store the reply
    
    On Error GoTo EH
    g_strErrorLocation = "frmSocket:wscFXRS_DataArrival"
    
    'Get the data from Winsock
    wscFXRS.GetData strReply, bytesTotal
    'Store current data packet in case reply takes multiple packets
    
    m_strDataArrival = m_strDataArrival & strReply
    
    'Check for 99,"" to see if you got the whole transaction else exit
    If InStr(1, strReply, "99," & Chr(34) & Chr(34)) = 0 Then
        Exit Sub
    Else
        MsgBox "Incoming:" & vbCrLf & m_strDataArrival, vbApplicationModal, g_strErrorLocation
        ' Deal with the data
        Set m_frmODBCTrans = New frmODBCTrans
        m_frmODBCTrans.SendTransaction (m_strDataArrival)
        m_strDataArrival = ""
    End If
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation

End Sub

